home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / kotl / knode.el < prev    next >
Encoding:
Text File  |  1995-06-16  |  2.7 KB  |  99 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         knode.el
  4. ;; SUMMARY:      Generic nodes for use as elements in data structures.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     extensions, hypermedia, outlines
  7. ;;
  8. ;; AUTHOR:       Kellie Clark & Bob Weiner
  9. ;;
  10. ;; ORIG-DATE:    5/1/93
  11. ;; LAST-MOD:     14-Jun-95 at 12:45:49 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;; Available for use and distribution under the same terms as GNU Emacs.
  15. ;;
  16. ;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
  17. ;; Developed with support from Motorola Inc.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;; DESCRIP-END.
  22.  
  23. ;;; ************************************************************************
  24. ;;; Public functions
  25. ;;; ************************************************************************
  26.  
  27. ;;;
  28. ;;; Knodes
  29. ;;;
  30.  
  31. (defun knode:create (contents &optional prop-list)
  32.   "Return a new knode which stores CONTENTS and optional PROP-LIST."
  33.   (list   'knode
  34.       'contents contents
  35.       'plist prop-list))
  36.  
  37. (defun knode:contents (knode)
  38.    "Return KNODE's contents."
  39.    (if (knode:is-p knode)
  40.        (car (cdr (memq 'contents knode)))
  41.      (error "(knode:contents): Argument must be a knode.")))
  42.  
  43. (fset 'knode:copy 'copy-tree)
  44.  
  45. (defun knode:is-p (object)
  46.   "Is OBJECT a knode?"
  47.   (and (listp object) (eq (car object) 'knode)))
  48.  
  49. (defun knode:set-contents (knode contents)
  50.   "Set KNODE's CONTENTS."
  51.   (if (knode:is-p knode)
  52.       (setcar (cdr (memq 'contents knode)) contents)
  53.     (error "(knode:set-contents): First arg must be a knode.")))
  54.  
  55. ;;; ************************************************************************
  56. ;;; Private functions
  57. ;;; ************************************************************************
  58.  
  59. (defun knode:get-attr (obj attribute)
  60.   "Return the value of OBJECT's ATTRIBUTE."
  61.   (car (cdr (memq attribute obj))))
  62.  
  63. (defun knode:remove-attr (obj attribute)
  64.   "Remove OBJECT's ATTRIBUTE, if any, and return modified OBJECT.
  65. Use (setq object (knode:remove-attr object attribute)) to ensure that OBJECT
  66. is updated."
  67.   (let ((tail obj)
  68.     sym
  69.     prev)
  70.     (setq sym (car tail))
  71.     (while (and sym (eq sym attribute))
  72.       (setq tail (cdr (cdr tail))
  73.         sym (car tail)))
  74.     (setq obj tail
  75.       prev tail
  76.       tail (cdr (cdr tail)))
  77.     (while tail
  78.       (setq sym (car tail))
  79.       (if (eq sym attribute)
  80.       (setcdr (cdr prev) (cdr (cdr tail))))
  81.       (setq prev tail
  82.         tail (cdr (cdr tail))))
  83.     obj))
  84.  
  85. (defun knode:set-attr (obj attribute value)
  86.   "Set OBJECT's ATTRIBUTE to VALUE and return OBJECT."
  87.   (let ((attr (memq attribute obj)))
  88.     (if attr
  89.     (setcar (cdr attr) value)
  90.       (setq obj (nconc obj (list attribute value)))))
  91.   obj)
  92.  
  93. ;;; ************************************************************************
  94. ;;; Private variables
  95. ;;; ************************************************************************
  96.  
  97. (provide 'knode)
  98.  
  99.